home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hardcore Visual Basic 5.0 (2nd Edition)
/
Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso
/
Code
/
Goodies
/
CallBack
/
SCROLBAR.CLS
< prev
next >
Wrap
Text File
|
1997-06-09
|
3KB
|
116 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ScrollBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
DefLng H
Public SB_TYPE As Integer 'SB_HORZ or SB_VERT
Private m_SmallChange As Integer
Private m_LargeChange As Integer
Public hm_hWnd
Private hm_Min
Private hm_Max
Public Function Change(wParam As Long) As Integer
Dim iChange As Integer
Dim lOldPos As Long
Dim lNewPos As Long
lOldPos = GetScrollPos(hm_hWnd, SB_TYPE)
Select Case wParam And &HFFFF&
Case SB_LINEUP: iChange = -m_SmallChange
Case SB_LINEDOWN: iChange = m_SmallChange
Case SB_PAGEUP: iChange = -m_LargeChange
Case SB_PAGEDOWN: iChange = m_LargeChange
Case SB_THUMBTRACK, SB_THUMBPOSITION:
iChange = wParam \ &H10000 - lOldPos
Case Else
Exit Function
End Select
If iChange Then
lNewPos = lOldPos + iChange
If lNewPos < hm_Min Then lNewPos = hm_Min
If lNewPos > hm_Max Then lNewPos = hm_Max
iChange = lOldPos - lNewPos
If iChange Then SetScrollPos hm_hWnd, SB_TYPE, lNewPos, 1
End If
Change = iChange
End Function
Public Property Let Value(NewValue As Integer)
SetScrollPos hm_hWnd, SB_TYPE, NewValue, 1
End Property
Public Property Get Value() As Integer
Value = GetScrollPos(hm_hWnd, SB_TYPE)
End Property
Public Property Let hWnd(Handle As Long)
hm_hWnd = Handle
If hm_hWnd Then
GetScrollRange hm_hWnd, SB_TYPE, hm_Min, hm_Max
End If
End Property
Public Property Get hWnd() As Long
hWnd = hm_hWnd
End Property
Public Property Let SmallChange(Value As Integer)
'>32767 taken care of by integer type
If Value < 1 Then Err.Raise 380 'Invalid property value.
m_SmallChange = Value
End Property
Public Property Get SmallChange() As Integer
SmallChange = m_SmallChange
End Property
Public Property Let LargeChange(Value As Integer)
'>32767 taken care of by integer type
If Value < 1 Then Err.Raise 380 'Invalid property value.
m_LargeChange = Value
End Property
Public Property Get LargeChange() As Integer
LargeChange = m_LargeChange
End Property
Public Property Let Max(Value As Integer)
Dim lValue As Long
'>32767 taken care of by integer type
If Value < 0 Then Err.Raise 380 'Invalid property value.
lValue = Value
SetScrollRange hm_hWnd, SB_TYPE, hm_Min, lValue, 1
hm_Max = Value
End Property
Public Property Get Max() As Integer
Max = hm_Max
End Property
Public Property Let Min(Value As Integer)
Dim lValue As Long
'>32767 taken care of by integer type
If Value < 0 Then Err.Raise 380 'Invalid property value.
lValue = Value
SetScrollRange hm_hWnd, SB_TYPE, lValue, hm_Max, 1
hm_Min = Value
End Property
Public Property Get Min() As Integer
Min = hm_Min
End Property
Private Sub Class_Initialize()
m_SmallChange = 1
m_LargeChange = 1
hm_Min = 0
hm_Max = 100
End Sub